;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
;@author Youming Lin, Michael Brandt
;@date Apr 8, 2012
;@version 1.0

(require "mmath.lisp")
(require "mcolor.lisp")
(require "mimage.lisp")
(require "moperation.lisp")
(require "mread-operations.lisp")
(require "minput.lisp")
(require "mblur.lisp")
(require "mborder.lisp")
(require "mbrightness.lisp")
(require "mcolormod.lisp")
(require "mcontrast.lisp")
(require "mcrop.lisp")
(require "mgreyscale.lisp")
(require "mhistogram.lisp")
(require "mhue.lisp")
(require "mmask.lisp")
(require "mmerge.lisp")
(require "mmirror.lisp")
(require "mnegative.lisp")
(require "moutput.lisp")
(require "mresize.lisp")
(require "mrotate.lisp")
(require "msaturation.lisp")
(require "msplitcolor.lisp")

(module MMain
  (include-book "io-utilities" :dir :teachpacks)
  (include-book "list-utilities" :dir :teachpacks)
  (set-state-ok t)
  
  (import IBrightness)
  (import IBorder)
  (import IBlur)
  (import IContrast)
  (import IColormod)
  (import ICrop)
  (import IGreyscale)
  (import IHistogram)
  (import IHue)
  (import IInput)
  (import IMask)
  (import IMirror)
  (import IMerge)
  (import INegative)
  (import IOperation)
  (import IOutput)
  (import IRead-Operations)
  (import IResize)
  (import IRotate)
  (import ISaturation)
  (import ISplitcolor)
  
  (defun perform-op (operation img)
    (if (listp operation)
        (let ((args (cadr operation))
              (op (car operation)))
          (cond ((equal op 'crop)
                 (crop img (first args) (second args) (third args)
                       (fourth args)))
                ((equal op 'colormod)
                 (colormod img (first args) (second args) (third args)))
                ((equal op 'blur)
                 (blur img (first args)))
                ((equal op 'mask)
                 (mask img (read-bmp-file (first args))))
                ((equal op 'merge)
                 (merge img (read-bmp-file (first args)) (second args)))
                ((equal op 'border) 
                 (border img (first args) (second args)))
                ((equal op 'negative)
                 (negative img))
                ((equal op 'histogram) 
                 (let ((out 
                        (string-list->file (first args)
                                           (histogram img) 
                                           state)))
                   img))
                 ((equal op 'rotate)
                  (rotate img (first args)))
                 ((equal op 'resize) 
                  (resize-scale img (first args)))
                 ((equal op 'greyscale)
                  (greyscale img))
                 ((equal op 'saturation)
                  (saturation img (first args)))
                 ((equal op 'contrast)
                  (contrast img (first args)))
                 ((equal op 'splitcolor)
                  (splitcolor img (first args)))
                 ((equal op 'mirror)
                  (mirror img (first args)))
                 ((equal op 'hue)
                  (hue img (first args)))
                 ((equal op 'brightness)
                  (brightness img (first args)))
                 (t nil)))
          nil))
    
    (defun process-ops (ops img-in)
      (if (endp ops)
          img-in
          (process-ops (cdr ops) (perform-op (car ops) img-in))))
    
    (defun main (ops-file bmp-input bmp-output)
      (let ((ops (read-operations ops-file))
            (img-in (read-bmp-file bmp-input)))
        (write-bmp-file (process-ops ops img-in) bmp-output)))

#|***************************************************
Enhancement: process multiple input images
*****************************************************|#
#| *** i/o helpers ***
|#

  (defund trim-aux (x)
    (declare (xargs :guard (character-listp x)))
    ;; Remove all whitespace characters from the front of a list.
    (if (consp x)
        (if (or (eql (car x) #\Space)
                (eql (car x) #\Tab)
                (eql (car x) #\Newline)
                (eql (car x) #\Page))
            (trim-aux (cdr x))
            x)
        nil))
  
  (defund trim (x)
    (declare (xargs :guard (stringp x)))
    (let* ((chars (coerce x 'list))
           (chars (trim-aux chars)) ;; eat spaces at the front
           (chars (reverse chars))  ;; flip so we can get to the back
           (chars (trim-aux chars)) ;; eat spaces at the back
           (chars (reverse chars))) ;; flip again so it's back to normal
      (coerce chars 'string)))
  
  (defun trim-list-of-strs (strs)
    (declare (xargs :guard (string-listp x)))
    ;; Trim all strings in a list of strings
    (if (consp strs)
        (cons (trim (car strs))
              (trim-list-of-strs (cdr strs)))
        nil))

  ;; reads input text file as a list of strings
  ; new string indicated by #\& character
  (defun input-as-strings (str)
    (map-chrs->str (remove nil (packets #\& (str->chrs str)))))
  #| -------------------------------------------|#

  
  #| ******* functions to handle data file ******* |#
  
  ;; gets tokens which are seperated by #\Newline for later storing into a list 
  ; for each data string of an input image file name, desired operations and output file name
  (defun get-data-strs (strs)
    (if (consp strs)
        (cons (map-chrs->str (remove nil 
                                     (packets-set (list (code-char 10) (code-char 13)) 
                                                  (str->chrs (car strs))))) 
              (get-data-strs (cdr strs)))
        nil))

  ;; transform each part of each data string into correct data type
  (defun transform-data (data-strs)
    (if (consp data-strs)
        (let* ((first-data (car data-strs))
               (input-file-name (trim (car first-data)))
               (operations (trim-list-of-strs (butlast (cdr first-data) 1)))
               (output-file-name (trim (car (last first-data)))))
          (cons (list input-file-name 
                      operations 
                      output-file-name)
                (transform-data (cdr data-strs))))
        nil))

  ;; gets the list of all data
  (defun get-data-list (str)
    (transform-data (get-data-strs (input-as-strings str))))
  
  ;; reads and stores data text file into a list of lists
  ; where each list contains string of input image file path,
  ; list of operation strings,
  ; and string of output file path
  (defun read-and-transform-data (input-file-path state)
    (mv-let (data-as-str error state)
            (file->string input-file-path state)
            (if error
                (mv error state)
                (mv (get-data-list data-as-str) error state))))
  
   (defun main-helper (data-as-list)
    (if (consp data-as-list)  
        (let* ((first-data 
              (car data-as-list))
            (first-input-image
             (car first-data))
            (commands-for-first-image
             (cadr first-data))
            (first-output-image
             (caddr first-data)))
        (if (main-helper (cdr data-as-list))
            (write-bmp-file (process-ops (read-operations commands-for-first-image) 
                                         (read-bmp-file first-input-image))
                            first-output-image)
            "ERROR"))
        t))
  
  #| ******* main function ******* |#
  ;; to run this program
  ; press run and in the run window of DrRacket
  ; type in (main-multiple-input "path of input file")
  (defun main-multiple-input (input-file) 
    (mv-let (data-as-list error state)
            (read-and-transform-data input-file state)
            (if error
                (mv error state)
                (mv-let (error-close state)
                        (main-helper data-as-list)
                       (if error-close
                           (mv error-close state)
                            (mv (string-append "input file: "
                                               input-file)
                                state))))))
  
#| -------------------------------------------|#
  
#|*****************************************************************************|#
  
      (export IMain))
  
  (link Run (MMath MColor MImage MOperation MRead-Operations
                   MInput MBlur MBorder MBrightness MColormod
                   MContrast MCrop MGreyscale MHistogram MHue
                   MMask MMerge MMirror MNegative MOutput MResize
                   MRotate MSaturation MSplitcolor MMain))
  (invoke Run)